home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbtools1.arc / AEQKSORT.BAS < prev    next >
BASIC Source File  |  1987-01-11  |  768b  |  37 lines
  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'Perform QuickSort on string array'
  4. '                Include the COMMON values
  5. rem $include:'AESHARED.BAS'            
  6.     
  7. sub qsort(fl$(1),elements%) static
  8.     dim stack(30,2)
  9.  
  10.     s=1:stack(1,1)=1:stack(1,2)=elements%
  11.     while s<>0
  12.         l=stack(s,1):r=stack(s,2):s=s-1
  13.         while l<r
  14.             i=l:j=r:x$=fl$((l+r)/2)
  15.             while j>=i
  16.                 while fl$(i)<x$
  17.                     i=i+1
  18.                 wend
  19.                 while x$<fl$(j)
  20.                     j=j-1
  21.                 wend
  22.                 if i<=j then
  23.                     swap fl$(j),fl$(i)
  24.                     i=i+1
  25.                     j=j-1
  26.                 end if
  27.             wend
  28.             if i<r then
  29.                 s=s+1
  30.                 stack(s,1)=i
  31.                 stack(s,2)=r
  32.             end if
  33.             r=j
  34.           wend
  35.     wend
  36. end sub
  37.